PC Answers 1995 May

home *** CD-ROM | disk | FTP | other *** search

/ PC Answers 1995 May / PC Answers CD-ROM 7 (Future Publishing) (May 1995).iso / vbits / code / mee / vbdao / visdata / dynaset.frm (.txt) < prev next >

Wrap

Visual Basic Form | 1994-10-06 | 29.2 KB | 974 lines

VERSION 2.00 Begin Form fDynaset BackColor = &H00C0C0C0& ClientHeight = 3750 ClientLeft = 1410 ClientTop = 2415 ClientWidth = 5655 Height = 4155 Icon = 0 Left = 1350 LinkTopic = "Form1" MDIChild = -1 'True ScaleHeight = 3733.906 ScaleMode = 0 'User ScaleWidth = 5675.316 Tag = "Dynaset" Top = 2070 Width = 5775 Begin PictureBox FieldHeader BackColor = &H00C0C0C0& BorderStyle = 0 'None Height = 240 Left = 0 ScaleHeight = 240 ScaleMode = 0 'User ScaleWidth = 5028 TabIndex = 16 Top = 480 Width = 5025 Begin Label FieldValueLabel BackColor = &H00C0C0C0& Caption = " Value (F4=Zoom) " Height = 255 Left = 1680 TabIndex = 18 Top = 0 Width = 3165 End Begin Label FieldHdrLabel BackColor = &H00C0C0C0& Caption = "Field Name:" Height = 252 Left = 120 TabIndex = 17 Top = 0 Width = 1212 End End Begin PictureBox ViewButtons Align = 1 'Align Top BackColor = &H00C0C0C0& BorderStyle = 0 'None Height = 495 Left = 0 ScaleHeight = 495 ScaleMode = 0 'User ScaleWidth = 5658.375 TabIndex = 0 Top = 0 Width = 5655 Begin CommandButton SortButton Caption = "&Sort" Height = 330 Left = 3128 TabIndex = 24 Top = 0 Width = 650 End Begin CommandButton FilterButton Caption = "F&ilter" Height = 330 Left = 2520 TabIndex = 23 Top = 0 Width = 650 End Begin CommandButton CloseButton Cancel = -1 'True Caption = "&Close" Height = 330 Left = 4367 TabIndex = 9 TabStop = 0 'False Top = 0 Width = 650 End Begin CommandButton PropButton Caption = "&Prop" Height = 330 Left = 3738 TabIndex = 5 Top = 0 Width = 650 End Begin CommandButton DelButton Caption = "&Del" Height = 330 Left = 1260 TabIndex = 4 Top = 0 Width = 650 End Begin CommandButton EditButton Caption = "&Edit" Height = 330 Left = 630 TabIndex = 3 Top = 0 Width = 650 End Begin CommandButton AddButton Caption = "&Add" Height = 330 Left = 0 TabIndex = 2 Top = 0 Width = 650 End Begin CommandButton FindButton Caption = "&Find" Height = 330 Left = 1890 TabIndex = 1 Top = 0 Width = 650 End End Begin PictureBox ChangeButtons BackColor = &H00C0C0C0& BorderStyle = 0 'None Height = 480 Left = 0 ScaleHeight = 480 ScaleMode = 0 'User ScaleWidth = 5028 TabIndex = 6 Top = 0 Visible = 0 'False Width = 5028 Begin CommandButton UpdateButton Caption = "&Update" Height = 372 Left = 960 TabIndex = 8 Top = 48 Width = 1212 End Begin CommandButton CancelButton Caption = "&Cancel" Height = 372 Left = 2640 TabIndex = 7 Top = 48 Width = 1212 End End Begin PictureBox StatBox Align = 2 'Align Bottom BackColor = &H00C0C0C0& BorderStyle = 0 'None Height = 281 Left = 0 ScaleHeight = 298.153 ScaleMode = 0 'User ScaleWidth = 5665.188 TabIndex = 14 Top = 3465 Width = 5655 Begin CommandButton NextButton Caption = ">" Height = 287 Left = 4200 TabIndex = 22 Top = 0 Width = 375 End Begin CommandButton LastButton Caption = ">|" Height = 287 Left = 4575 TabIndex = 21 Top = 0 Width = 375 End Begin CommandButton FirstButton Caption = "|<" Height = 287 Left = 0 TabIndex = 20 Top = 0 Width = 375 End Begin CommandButton PrevButton Caption = "<" Height = 287 Left = 375 TabIndex = 19 Top = 0 Width = 375 End Begin Label cStatusBar BackColor = &H00FFFFFF& BorderStyle = 1 'Fixed Single Height = 287 Left = 749 TabIndex = 15 Top = 5 Width = 3360 End End Begin VScrollBar cScrollBar Height = 2616 LargeChange = 3000 Left = 5040 SmallChange = 300 TabIndex = 13 Top = 720 Visible = 0 'False Width = 252 End Begin PictureBox cFields BackColor = &H00C0C0C0& BorderStyle = 0 'None Height = 375 Left = 120 ScaleHeight = 372 ScaleMode = 0 'User ScaleWidth = 4812 TabIndex = 10 Top = 720 Width = 4815 Begin TextBox cFieldData BackColor = &H00FFFFFF& DataSource = "Data1" ForeColor = &H00000000& Height = 288 Index = 0 Left = 1560 TabIndex = 11 Top = 0 Visible = 0 'False Width = 3252 End Begin Label cFieldName BackColor = &H00C0C0C0& ForeColor = &H00000000& Height = 252 Index = 0 Left = 0 TabIndex = 12 Top = 60 Visible = 0 'False Width = 1572 End End Option Explicit 'form variables Dim FDS As Dynaset 'current form's dynaset Dim FTblName As String 'form dynaset table name Dim FBM As String 'form bookmark Dim FNotFound As Integer 'used by find function Dim FAtTop As Integer 'top flag Dim FEditFlag As Integer 'edit mode Dim FAddNewFlag As Integer 'add mode Dim FFldDataChanged As Integer Dim FFindForm As New fFind 'find form instance Dim FCurrRec As Integer 'record counter Dim FNumbRows As Long 'total rows in dynaset Dim FDynaString As String 'dynaset open string Sub AddButton_Click () On Error GoTo AddErr 'set the mode FDS.AddNew cStatusBar = "Add record" FAddNewFlag = True If FDS.RecordCount > 0 Then FBM = FDS.Bookmark Else FBM = NULL_STR End If ChangeButtons.Visible = True ViewButtons.Visible = False NextButton.Enabled = False FirstButton.Enabled = False LastButton.Enabled = False PrevButton.Enabled = False ClearDataFields cFieldData(0).SetFocus GoTo AddEnd AddErr: ShowError Resume AddEnd AddEnd: End Sub Sub CancelButton_Click () On Error Resume Next ChangeButtons.Visible = False ViewButtons.Visible = True NextButton.Enabled = True FirstButton.Enabled = True LastButton.Enabled = True PrevButton.Enabled = True FEditFlag = False FAddNewFlag = False If Len(FBM) > 0 Then FDS.Bookmark = FBM DisplayCurrentRecord End Sub Sub cFieldData_Change (Index As Integer) 'just set the flag if data is changed 'it gets reset to false when a new record is displayed FFldDataChanged = True End Sub Sub cFieldData_KeyDown (Index As Integer, KeyCode As Integer, Shift As Integer) If KeyCode = &H73 Then 'F4 cFieldName_DblClick Index ElseIf KeyCode = 34 And cScrollBar.Visible = True Then 'pagedown with > 10 fields cScrollBar = cScrollBar - 3000 ElseIf KeyCode = 33 And cScrollBar.Visible = True Then 'pageup with > 10 fields cScrollBar = cScrollBar + 3000 End If End Sub Sub cFieldData_KeyPress (Index As Integer, KeyAscii As Integer) 'only allow return when in edit of add mode If FEditFlag = True Or FAddNewFlag = True Then If KeyAscii = 13 Then KeyAscii = 0 SendKeys "{Tab}" End If 'throw away the keystrokes if not in add or edit mode ElseIf FEditFlag = False And FAddNewFlag = False Then KeyAscii = 0 End If End Sub Sub cFieldData_LostFocus (Index As Integer) On Error GoTo FldDataErr If FFldDataChanged = True Then 'store the data in the field FDS(Index) = cFieldData(Index) End If GoTo FldDataEnd FldDataErr: ShowError Resume FldDataEnd FldDataEnd: 'reset for valid or error condition FFldDataChanged = False End Sub Sub cFieldName_DblClick (Index As Integer) On Error GoTo ZoomErr If FDS(Index).Type = FT_STRING Or FDS(Index).Type = FT_MEMO Then If FDS(Index).FieldSize() < GETCHUNK_CUTOFF Then gstZoomData = cFieldData(Index) Else 'add the rest of the field data with getchunk MsgBar "Getting Memo Field Data", True SetHourglass Me gstZoomData = cFieldData(Index) + StripNonAscii(FDS(Index).GetChunk(GETCHUNK_CUTOFF, MAX_MEMO_SIZE)) ResetMouse Me MsgBar NULL_STR, False End If fZoom.Caption = Mid(cFieldName(Index), 1, Len(cFieldName(Index)) - 1) fZoom.Top = Top + 1200 fZoom.Left = Left + 250 If FAddNewFlag Or FEditFlag Then fZoom.SaveButton.Visible = True fZoom.CloseButton.Visible = True Else fZoom.CloseZoomButton.Visible = True End If If FDS(Index).Type <> FT_MEMO Then fZoom.cData = gstZoomData fZoom.Height = 1125 Else fZoom.cMemo = gstZoomData fZoom.cMemo.Visible = True fZoom.cData.Visible = False fZoom.Height = 2205 End If fZoom.Show MODAL If (FAddNewFlag Or FEditFlag) And gstZoomData <> "__CANCELLED__" Then If FDS(Index).Type = FT_STRING And Len(gstZoomData) > FDS(Index).Size Then Beep MsgBox "Field Length Exceeded, Data Truncated!", 48 cFieldData(Index) = Mid(gstZoomData, 1, FDS(Index).Size) Else cFieldData(Index) = gstZoomData End If FDS(Index) = cFieldData(Index) FFldDataChanged = False End If End If GoTo ZoomEnd ZoomErr: ShowError Resume ZoomEnd ZoomEnd: End Sub Sub ClearDataFields () Dim i As Integer 'clear out the fields on the main form For i = 0 To FDS.Fields.Count - 1 cFieldData(i) = NULL_STR Next End Sub Sub CloseButton_Click () Unload Me End Sub Sub cScrollBar_Change () Dim t As Integer t = cScrollBar If (t - 720) Mod 300 = 0 Then cFields.Top = t Else cFields.Top = ((t - 720) \ 300) * 300 + 720 End If End Sub Sub DelButton_Click () On Error GoTo DelRecErr If MsgBox("Delete Current Record?", MSGBOX_TYPE) = YES Then FDS.Delete If gfTransPending Then gfDBChanged = True If FDS.EOF = False Then FDS.MoveNext End If FNumbRows = FNumbRows - 1 DisplayCurrentRecord End If GoTo DelRecEnd DelRecErr: ShowError Resume DelRecEnd DelRecEnd: End Sub Sub DisplayCurrentRecord () Dim i As Integer Dim cst As String 'current status bar On Error GoTo DCRErr SetHourglass Me cst = "Record " 'check BOF/EOF flag so we know if we 'are sitting on a valid record If FAddNewFlag = True Then cst = cst + CStr(FCurrRec) & " of " & CStr(FNumbRows) Else If FDS.BOF = True Then cst = cst & "(BOF) of " & CStr(FNumbRows) ClearDataFields ElseIf FDS.EOF = True Then cst = cst & "(EOF) of " & CStr(FNumbRows) ClearDataFields Else cst = cst + CStr(FCurrRec) & " of " & CStr(FNumbRows) 'place the data in the form fields For i = 0 To FDS.Fields.Count - 1 If FDS(i).Type = FT_MEMO Then If FDS(i).FieldSize() < GETCHUNK_CUTOFF Then cFieldData(i) = StripNonAscii(vFieldVal(FDS(i))) Else cFieldData(i) = StripNonAscii(vFieldVal(FDS(i).GetChunk(0, GETCHUNK_CUTOFF))) End If ElseIf FDS(i).Type = FT_STRING Then cFieldData(i) = StripNonAscii(vFieldVal(FDS(i))) Else cFieldData(i) = vFieldVal(FDS(i)) End If Next End If End If If FDS.Updatable = False Then cst = cst & " [Not Updatable]" cStatusBar = cst 'set the flag FFldDataChanged = False GoTo DCREnd DCRErr: ShowError Resume DCREnd DCREnd: ResetMouse Me End Sub Sub EditButton_Click () On Error GoTo EditErr FDS.Edit cStatusBar = "Edit record" FEditFlag = True cFieldData(0).SetFocus FBM = FDS.Bookmark ChangeButtons.Visible = True ViewButtons.Visible = False NextButton.Enabled = False FirstButton.Enabled = False LastButton.Enabled = False PrevButton.Enabled = False GoTo EditEnd EditErr: ShowError Resume EditEnd EditEnd: End Sub Sub FilterButton_Click () On Error GoTo FilterErr Dim bm As String Dim ds1 As Dynaset, ds2 As Dynaset Dim FilterStr As String bm = FDS.Bookmark 'save the bookmark Set ds1 = FDS 'save the dynaset FilterStr = InputBox("Enter Filter Expression:") If Len(FilterStr) = 0 Then Exit Sub SetHourglass Me MsgBar "Setting New Filter", True FDS.Filter = FilterStr Set ds2 = FDS.CreateDynaset() 'establish the filter Set FDS = ds2 'assign back to original dynaset object 'everything must be okay so redisplay form on 1st record FNumbRows = GetNumbRecs(FDS) 'query numb of recs FCurrRec = 1 DisplayCurrentRecord 'display field values FAtTop = True ResetMouse Me MsgBar NULL_STR, False GoTo FilterEnd FilterErr: ResetMouse Me MsgBar NULL_STR, False ShowError Set FDS = ds1 're-assign back to original FDS.Bookmark = bm 'go back to original record Resume FilterEnd FilterEnd: End Sub Sub FindButton_Click () Dim i As Integer Dim bm As String On Error GoTo FindErr 'load the column names into the find form If FFindForm.cFieldList.ListCount = 0 Then For i = 0 To FDS.Fields.Count - 1 FFindForm.cFieldList.AddItem Mid(cFieldName(i), 1, Len(cFieldName(i)) - 1) Next End If FindStart: 'reset the flags gfFindFailed = False gfFromTableView = False FNotFound = False MsgBar "Enter Search Parameters", False FFindForm.Show MODAL MsgBar "Searching for New Record", True If gfFindFailed = True Then 'find cancelled GoTo AfterWhile End If SetHourglass Me i = FFindForm.cFieldList.ListIndex 'search for the record bm = FDS.Bookmark If FDS(i).Type = FT_STRING Or FDS(i).Type = FT_MEMO Then FDS.FindFirst AddBrackets((FDS(i).Name)) & " " & gstFindOp & " '" & gstFindExpr & "'" Else FDS.FindFirst AddBrackets((FDS(i).Name)) + gstFindOp + gstFindExpr End If FNotFound = FDS.NoMatch AfterWhile: ResetMouse Me If gfFindFailed = True Then 'go back to top FDS.Bookmark = bm ElseIf FNotFound Then Beep MsgBox "Record Not Found", 48 FDS.Bookmark = bm GoTo FindStart Else bm = FDS.Bookmark FDS.MoveFirst FCurrRec = 1 While FDS.Bookmark <> bm FCurrRec = FCurrRec + 1 FDS.MoveNext Wend End If DisplayCurrentRecord GoTo FindEnd FindErr: ResetMouse Me If Err <> EOF_ERR Then ShowError Resume FindEnd Else FNotFound = True Resume Next End If FindEnd: MsgBar NULL_STR, False End Sub Sub FirstButton_Click () Dim ds As String On Error GoTo GoFirstError FDS.MoveFirst FCurrRec = 1 DisplayCurrentRecord FAtTop = True GoTo GoFirstEnd GoFirstError: ShowError Resume GoFirstEnd GoFirstEnd: ResetMouse Me MsgBar NULL_STR, False End Sub Sub Form_KeyDown (KeyCode As Integer, Shift As Integer) If FEditFlag = True Or FAddNewFlag = True Then Exit Sub Select Case KeyCode Case 35 'end Call LastButton_Click Case 36 'home Call FirstButton_Click Case 38 'up arrow If Shift = 2 Then Call FirstButton_Click Else Call PrevButton_Click End If Case 40 'down arrow If Shift = 2 Then Call LastButton_Click Else Call NextButton_Click End If Case 114 'F3 Call FindButton_Click End Select End Sub Sub Form_Load () Dim t As TableDef 'local table structure Dim sp As Integer 'starting point of table name Dim ep As Integer 'ending point of table name Dim ds As String 'temp dynaset name string Dim wh As String 'where clause Dim ft As Integer Dim i As Integer, j As Integer Dim fn As String 'field name Dim l As Long Dim qd As QueryDef 'querydef for parameterized query Dim p_query As Integer 'param query flag Dim p_val As String 'param value Dim Start1, Finish1, Start2, Finish2 On Error GoTo DynasetErr SetHourglass Me MsgBar "Opening Dynaset", True 'disable match case checkbox on find form 'because it isn't implemented on this form FFindForm.cMatchCase.Enabled = False 'assign the temp string with the select statement 'if it is not empty, otherwise, use the table list name If gfFromSQL = True Then If Len(gstDynaString) = 0 Then ds = fSQL.cSQLStatement Else ds = gstDynaString End If ElseIf Len(gstTableDynaFilter) > 0 Then ds = gstTableDynaFilter Else ds = fTables.cTableList End If 'check for parameters If InStr(ds, "PARAM1") > 0 Or InStr(gstDynaString, "PARAM1") > 0 Then 'figure out if it is a saved querydef If Mid(UCase(ds), 1, 7) = "SELECT " Then Set qd = gCurrentDB.CreateQueryDef("temp_qd", ds) p_query = 1 Else Set qd = gCurrentDB.OpenQueryDef(fTables.cTableList) p_query = 2 End If 'get the parameter value(s) For i = 1 To 4 p_val = "" p_val = InputBox("Enter the value for parameter " & i) Select Case i Case 1 qd!PARAM1 = p_val Case 2 qd!PARAM2 = p_val Case 3 qd!PARAM3 = p_val Case 4 qd!PARAM4 = p_val End Select If InStr(ds, "PARAM" & i + 1) = 0 And InStr(gstDynaString, "PARAM" & i + 1) = 0 Then Exit For Next End If 'attemp to open the dynaset Start1 = TimeGetTime() If gfFromSQL = True Then If VDMDI.cPassThru.Visible = True And VDMDI.cPassThru = 1 Then Set FDS = gCurrentDB.CreateDynaset(ds, VBDA_SQLPASSTHROUGH) Else Set FDS = gCurrentDB.CreateDynaset(ds) End If Else If p_query = 0 Then If VDMDI.cPassThru.Visible = True And VDMDI.cPassThru = 1 Then ds = "select * from " & StripOwner(ds) Set FDS = gCurrentDB.CreateDynaset(ds, VBDA_SQLPASSTHROUGH) Else Set FDS = gCurrentDB.CreateDynaset(ds) End If Else Set FDS = qd.CreateDynaset() qd.Close If p_query = 1 Then gCurrentDB.DeleteQueryDef "temp_qd" End If End If Finish1 = TimeGetTime() Start2 = TimeGetTime() 'parse off table name to store in global gstTblName wh = NULL_STR sp = InStr(1, UCase(ds), "FROM") If sp > 0 Then 'must be a "select from" statement sp = sp + 5 For ep = sp To Len(ds) 'search for a space or the end of ds If Mid$(ds, ep, 1) = " " Or Mid$(ds, ep, 1) = Chr(13) Then 'get where clause if there is one wh = Mid$(ds, sp, Len(ds) - sp + 1) Exit For End If Next FTblName = UCase(Mid$(ds, sp, ep - sp)) If Len(wh) = 0 Then wh = FTblName Else 'must be a table name only FTblName = UCase(ds) wh = FTblName End If FDynaString = wh 'show the first record FNumbRows = GetNumbRecs(FDS) 'query numb of recs 'load the controls on the dynaset form cFieldName(0).Visible = True cFieldData(0).Visible = True ft = FDS(0).Type cFieldData(0).Width = GetFieldWidth(ft) If ft = FT_STRING Then cFieldData(0).MaxLength = FDS(0).Size cFieldData(0).TabIndex = 0 For i = 1 To FDS.Fields.Count - 1 cFields.Height = cFields.Height + 300 Load cFieldName(i) cFieldName(i).Top = cFieldName(i - 1).Top + 300 cFieldName(i).Visible = True Load cFieldData(i) cFieldData(i).Top = cFieldData(i - 1).Top + 300 cFieldData(i).Visible = True ft = FDS.Fields(i).Type cFieldData(i).Width = GetFieldWidth(ft) If ft = FT_STRING Then cFieldData(i).MaxLength = FDS(i).Size cFieldData(i).TabIndex = i Next 'resize main window If i <= 10 Then Height = ((i + 1) * 300) + 1400 Else Height = 4368 Width = Width + 260 cScrollBar.Visible = True cScrollBar.Min = 720 cScrollBar.Max = 720 - (i * 300) + 3000 End If 'display the field names For i = 0 To FDS.Fields.Count - 1 cFieldName(i) = UCase(FDS(i).Name) & ":" Next FCurrRec = 1 DisplayCurrentRecord 'display field values FAtTop = True If Len(gstTableDynaFilter) > 0 Then caption = "Filtered Dynaset: " & FTblName Else caption = "Dynaset: " & FTblName End If Width = 5805 Left = 1000 Top = 1000 Finish2 = TimeGetTime() If VDMDI.PrefShowPerf.Checked Then Me.Show MsgBox FNumbRows & " rows found in " & (Finish1 - Start1) / 1000 & " seconds!" & Chr(13) & Chr(10) & (Finish2 - Start2) / 1000 & " seconds to Get Record Count!", 48 End If GoTo OkayEnd DynasetErr: If p_query = 1 Then gCurrentDB.DeleteQueryDef "temp_qd" End If ShowError ResetMouse Me Unload Me MsgBar NULL_STR, False Exit Sub Resume OkayEnd OkayEnd: ResetMouse Me MsgBar NULL_STR, False Exit Sub End Sub Sub Form_Paint () Outlines Me End Sub Sub Form_Resize () On Error Resume Next Dim h As Integer, i As Integer Dim totw As Integer If WindowState <> 1 Then 'not minimized MsgBar "Resizing Form", True 'make sure the form is lined up on a field h = Height If (h - 1420) Mod 300 <> 0 Then Height = ((h - 1420) \ 300) * 300 + 1420 End If 'resize the status bar StatBox.Top = Height - 650 'resize the scrollbar cScrollBar.Height = StatBox.Top - (ViewButtons.Top - FieldHeader.Height) - 960 cScrollBar.Left = Width - 360 If FDS.Fields.Count > 10 Then cFields.Width = Width - 260 totw = cScrollBar.Left - 20 Else cFields.Width = Width - 20 totw = Width - 50 End If FieldHeader.Width = Width - 20 'widen the fields if possible For i = 0 To FDS.Fields.Count - 1 cFieldName(i).Width = .3 * totw cFieldData(i).Left = cFieldName(i).Width + 20 If FDS(i).Type = FT_STRING Or FDS(i).Type = FT_MEMO Then cFieldData(i).Width = .7 * totw - 250 End If Next FieldValueLabel.Left = cFieldData(0).Left cStatusBar.Width = Width - 1600 NextButton.Left = cStatusBar.Width + 745 LastButton.Left = NextButton.Left + 370 End If MsgBar NULL_STR, False End Sub Sub Form_Unload (Cancel As Integer) On Error Resume Next Unload FFindForm 'get rid of attached find form FDS.Close 'close the form dynaset MsgBar NULL_STR, False End Sub Sub LastButton_Click () On Error GoTo GoLastError FDS.MoveLast 'show the current record FCurrRec = FNumbRows DisplayCurrentRecord GoTo GoLastEnd GoLastError: ShowError Resume GoLastEnd GoLastEnd: End Sub Sub NextButton_Click () On Error GoTo GoNextError FDS.MoveNext 'show the current record FCurrRec = FCurrRec + 1 'bump the record counter DisplayCurrentRecord FAtTop = False GoTo GoNextEnd GoNextError: ShowError Resume GoNextEnd GoNextEnd: End Sub Sub PrevButton_Click () On Error GoTo GoPrevError FDS.MovePrevious 'show the current record FCurrRec = FCurrRec - 1 'bump the record counter back DisplayCurrentRecord FAtTop = False GoTo GoPrevEnd GoPrevError: ShowError Resume GoPrevEnd GoPrevEnd: End Sub Sub PropButton_Click () Dim f As New fDataBox On Error GoTo DynPropErr Set gCurrentDS = FDS f.Caption = "Dynaset Properties" f.Tag = "DS" f.cData.AddItem "Name = " & FDS.Name f.cData.AddItem "BOF Flag = " & stTrueFalse((FDS.BOF)) f.cData.AddItem "BookMark = " & FDS.Bookmark f.cData.AddItem "BookMarkable Flag = " & stTrueFalse((FDS.Bookmarkable)) f.cData.AddItem "EOF Flag = " & stTrueFalse((FDS.EOF)) f.cData.AddItem "Filter = " & FDS.Filter f.cData.AddItem "Last Modified = " & FDS.LastModified f.cData.AddItem "Lock Edits Flag = " & stTrueFalse((FDS.LockEdits)) f.cData.AddItem "No Match Flag = " & stTrueFalse((FDS.NoMatch)) f.cData.AddItem "Sort = " & FDS.Sort f.cData.AddItem "Transactions Flag = " & stTrueFalse((FDS.Transactions)) f.cData.AddItem "RecordCount = " & FDS.RecordCount f.cData.AddItem "Updatable Flag = " & stTrueFalse((FDS.Updatable)) f.Show MODAL GoTo DynPropEnd DynPropErr: f.cData.AddItem Error$ Resume Next DynPropEnd: End Sub Sub SortButton_Click () On Error GoTo SortErr Dim bm As String Dim ds1 As Dynaset, ds2 As Dynaset Dim SortStr As String bm = FDS.Bookmark 'save the bookmark Set ds1 = FDS 'save the dynaset SortStr = InputBox("Enter Sort Column:") If Len(SortStr) = 0 Then Exit Sub SetHourglass Me MsgBar "Setting New Sort Order", True FDS.Sort = SortStr Set ds2 = FDS.CreateDynaset() 'establish the Sort Set FDS = ds2 'assign back to original dynaset object 'everything must be okay so redisplay form on 1st record FNumbRows = GetNumbRecs(FDS) 'query numb of recs FCurrRec = 1 DisplayCurrentRecord 'display field values FAtTop = True ResetMouse Me MsgBar NULL_STR, False GoTo SortEnd SortErr: ResetMouse Me MsgBar NULL_STR, False ShowError Set FDS = ds1 're-assign back to original FDS.Bookmark = bm 'go back to original record Resume SortEnd SortEnd: End Sub Sub UpdateButton_Click () On Error GoTo UpdateErr FDS.Update If gfTransPending Then gfDBChanged = True If FAddNewFlag = True Then FNumbRows = FNumbRows + 1 FCurrRec = FNumbRows FDS.MoveLast 'move to the new record End If ChangeButtons.Visible = False ViewButtons.Visible = True NextButton.Enabled = True FirstButton.Enabled = True LastButton.Enabled = True PrevButton.Enabled = True FEditFlag = False FAddNewFlag = False DisplayCurrentRecord GoTo UpdateEnd UpdateErr: ShowError Resume UpdateEnd UpdateEnd: End Sub